home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / basic1 / pro21 / menusub.bas < prev    next >
BASIC Source File  |  1986-12-09  |  3KB  |  118 lines
  1. REM                         -=<MENU>=-
  2. REM
  3. REM SUBROUTINE TO CREATE SCROLLING-BAR MENU'S IN QUICKBASIC 2.0
  4. REM
  5. REM                      BY SCOTT L. BAIN
  6. REM                          12/10/86
  7. REM
  8. REM
  9. REM DESCRIPTION:
  10. REM -----------     PROGRAM CREATES A VERTICAL MENU, THEN USING THE ARROW
  11. REM                 AND ENTER KEYS, USER MAY SELECT ITEM FROM THOSE LISTED
  12. REM                 IN STRING ARRAY.  PGUP, PGDN, HOME, END, AND WRAP-AROUND
  13. REM                 ARE ALL SUPPORTED.  USER MAY ALTERNATIVELY PRESS THE
  14. REM                 FIRST LETTER OF A CHOICE TO SELECT IT.
  15. REM
  16. REM SAMPLE CALL:
  17. REM -----------     CALL MENU(AR$,UR,MR,FC,BC,CH)
  18. REM
  19. REM PARAMETERS:
  20. REM ----------      AR$- ONE DIMENSIONAL ARRAY, CONTAINING CHOICE STRINGS
  21. REM                 UR - UPPER ROW (1-24)
  22. REM                 MR - MARGIN (1-79)
  23. REM                 FC - FOREGROUND COLOR
  24. REM                 BC - BACKGROUND COLOR
  25. REM                 CH - CHOICE (INITIAL CHOICE/RETURNED CHOICE VALUE)
  26. REM
  27. REM IF THE ZEROETH ELEMENT OF AR$ IS NOT EMPTY, THEN THE CONTENTS WILL BE
  28. REM USED AS A CENTERED TITLE, ASSUMING THAT AT LEAST ONE BLANK SCREEN LINE IS
  29. REM AVAILABLE ABOVE THE MENU.  THE TITLE WILL BE WRITTEN IN THE COLOR AS SET
  30. REM BEFORE ENTERING THE MENU ROUTINE (NOT FC,BC).
  31. REM                                   ---
  32. REM NOTE: DUE TO A QB 2.0 BUG, DO NOT USE OPTION BASE 1 IN THE CALLING PROG.
  33. REM       IF NO TITLES ARE DESIRED, SIMPLY LEAVE ELEMENT 0 EMPTY ("").
  34.  
  35. SUB MENU (AR$(1),UR,MR,FC,BC,CH) STATIC
  36.  
  37.     REM - PHASE I: TEST PARAMETERS FOR VALIDITY
  38.     IF UBOUND(AR$)<1 THEN GOTO BAD
  39.     IF MR>79 THEN GOTO BAD
  40.     IF UR+UBOUND(AR$)>24 THEN GOTO BAD
  41.     IF FC<0 OR FC>31 OR FC<>INT(FC) THEN GOTO BAD
  42.     IF BC<0 OR BC>15 OR BC<>INT(BC) THEN GOTO BAD
  43.  
  44.     REM - PHASE II: BUILD
  45.     LN=0
  46.     FOR I=0 TO UBOUND(AR$)
  47.         IF LEN(AR$(I))>LN THEN LN=LEN(AR$(I))
  48.     NEXT I
  49.     IF LBOUND(AR$)=0 THEN
  50.         IF AR$(0)<>"" AND UR<>1 THEN
  51.             LOCATE UR-1,MR+((LN-LEN(AR$(0)))/2)
  52.             PRINT AR$(0);
  53.         END IF
  54.     END IF
  55.     COLOR FC,BC
  56.     FOR I=1 TO UBOUND(AR$)
  57.         LOCATE UR+I-1,MR
  58.         A$=AR$(I)
  59.         AR$(I)=A$+STRING$(LN-LEN(A$),32)
  60.         PRINT AR$(I);
  61.     NEXT I
  62.  
  63.     REM - PHASE III: GET THE CHOICE
  64.     CHOOSING=1
  65.     OLD=CH
  66.     WHILE CHOOSING=1
  67.         COLOR FC,BC
  68.         LOCATE UR+OLD-1,MR
  69.         PRINT AR$(OLD);
  70.         COLOR 12,0
  71.         LOCATE UR+CH-1,MR
  72.         PRINT AR$(CH);
  73.         OLD=CH
  74.         A$=""
  75.         WHILE A$="":A$=INKEY$:WEND
  76.         IF LEN(A$)=2 THEN A=ASC(RIGHT$(A$,1)) ELSE A=ASC(A$)
  77.         IF A=13 OR A=27 THEN CHOOSING=0
  78.         IF LEN(A$)=1 THEN
  79.             FOR J=UBOUND(AR$) TO 1 STEP -1
  80.                 IF A=ASC(AR$(J)) THEN
  81.                     CH=J
  82.                     COLOR FC,BC
  83.                     LOCATE UR+OLD-1,MR
  84.                     PRINT AR$(OLD);
  85.                     COLOR 12,0
  86.                     LOCATE UR+CH-1,MR
  87.                     PRINT AR$(CH);
  88.                     CHOOSING=0
  89.                 END IF
  90.             NEXT J
  91.         ELSE
  92.             IF A=72 OR A=56 THEN
  93.                 CH=CH-1
  94.             ELSEIF A=80 OR A=50 THEN
  95.                 CH=CH+1
  96.             ELSEIF A=71 OR A=73 OR A=55 OR A=57 THEN
  97.                 CH=1
  98.             ELSEIF A=79 OR A=81 OR A=49 OR A=51 THEN
  99.                 CH=UBOUND(AR$)
  100.             END IF
  101.         END IF
  102.         IF CH>UBOUND(AR$) THEN CH=1
  103.         IF CH<1 THEN CH=UBOUND(AR$)
  104.     WEND
  105.     GOTO DONE:
  106.  
  107. BAD:
  108. PRINT "BAD PARAMETER(S) IN MENU CALL"
  109. A$=INPUT$(1)
  110.  
  111. DONE:
  112. COLOR FC,BC
  113. END SUB
  114.  
  115.  
  116.  
  117.  
  118.